home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / boot / fastlib.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  7.8 KB  |  260 lines
  1. (* Copyright 1989 by AT&T Bell Laboratories *)
  2. structure Fastlib = struct
  3.  
  4. structure Ref = 
  5.   struct
  6.     open Ref
  7.     fun inc r = r := !r + 1
  8.     fun dec r = r := !r - 1
  9.   end
  10.  
  11. structure List : LIST =
  12.   struct
  13.     open List
  14.     fun hd (a::r) = a | hd nil = raise Hd
  15.     fun tl (a::r) = r | tl nil = raise Tl    
  16.     fun null nil = true | null _ = false
  17.     fun length l = 
  18.     let fun j(k,nil) = k
  19.           | j(k, a::x) = j(k+1,x)
  20.      in j(0,l)
  21.     end
  22.     fun op @ (nil,l) = l
  23.       | op @ (a::r, l) = a :: (r@l)
  24.     fun rev l =
  25.     let fun f (nil, h) = h
  26.           | f (a::r, h) = f(r, a::h)
  27.     in  f(l,nil)
  28.     end
  29.     fun map f =
  30.     let fun m nil = nil
  31.           | m (a::r) = f a :: m r
  32.     in  m
  33.     end
  34.     fun fold f [] = (fn b => b)
  35.       | fold f (a::r) = (fn b => let fun f2(e,[]) = f(e,b)
  36.                        | f2(e,a::r) = f(e,f2(a,r))
  37.                  in f2(a,r)
  38.                  end)
  39.     fun revfold f [] = (fn b => b)
  40.       | revfold f (a::r) = (fn b => let fun f2(e,[],b) = f(e,b)
  41.                       | f2(e,a::r,b) = f2(a,r,f(e,b))
  42.                     in f2(a,r,b)
  43.                     end)    
  44.     fun app f = let fun a2 (e::r) = (f e; a2 r) | a2 nil = () in a2 end
  45.     fun revapp f = let fun a2 (e::r) = (a2 r; f e; ()) | a2 nil = () in a2 end
  46.     fun nthtail(e,0) = e 
  47.       | nthtail(e::r,n) = nthtail(r,n-1)
  48.       | nthtail _ = raise NthTail
  49.     fun nth x = hd(nthtail x) handle NthTail => raise Nth | Hd => raise Nth
  50.     fun exists pred =
  51.     let fun f nil = false
  52.           | f (hd::tl) = pred hd orelse f tl
  53.     in  f
  54.     end
  55.   end
  56.  
  57. structure ByteArray (* : BYTEARRAY *) =
  58.   struct
  59.     open ByteArray
  60.    local open System.Unsafe
  61.          val slength:bytearray -> int = cast slength
  62.          val store:bytearray * int * int -> unit = cast store
  63.          val ordof:bytearray * int -> int = cast ordof
  64.     in
  65.     val length = slength
  66.     fun update(arg as (s,i,c)) =
  67.         if i<0 orelse i >= slength s then raise Subscript
  68.         else if c<0 orelse c>255 then raise Range
  69.         else store arg
  70.     val op sub = fn (s,i) => if i<0 orelse i>= slength s then raise Subscript
  71.                              else ordof(s,i)
  72.     fun extract(ba,i,1) : string =
  73.         if i<0 orelse i >= slength ba then raise Subscript
  74.                           else cast ordof(ba,i)
  75.       | extract(s,i,len) =
  76.           if i<0 orelse i+len > slength s orelse len<0 then raise Subscript
  77.           else if len=0 then cast Assembly.bytearray0
  78.           else let val a = Assembly.A.create_b len
  79.                    fun copy j =  if j=len then ()
  80.                                  else (store(a,j,ordof(s,i+j)); copy(j+1))
  81.                in  copy 0; cast a
  82.                end
  83.     fun app f ba =
  84.         let val len = slength ba
  85.             fun app' i = if i >= len then ()
  86.                          else (f(ordof(ba,i)); app'(i+1))
  87.         in  app' 0
  88.         end
  89.     fun revapp f ba =
  90.         let fun revapp' i = if i < 0 then ()
  91.                             else (f(ordof(ba,i)); revapp'(i-1))
  92.         in  revapp'(slength ba - 1)
  93.         end
  94.     fun fold f ba x =
  95.         let fun fold'(i,x) = if i < 0 then x else fold'(i-1, f(ordof(ba,i),x))
  96.         in  fold'(slength ba - 1, x)
  97.         end
  98.     fun revfold f ba x =
  99.         let val len = slength ba
  100.             fun revfold'(i,x) = if i >= len then x
  101.                                 else revfold'(i+1,f(ordof(ba,i),x))
  102.         in  revfold'(0,x)
  103.         end
  104.     end
  105.   end
  106.  
  107. structure String =
  108.   struct
  109.     open String
  110.     local open System.Unsafe
  111.       val op > = Integer.> and op >= = Integer.>=
  112.       val op < = Integer.< and op <= = Integer.<=
  113.      in
  114.     fun length s = if boxed s then slength s else 1
  115.  
  116.     val size = length
  117.     fun substring("",0,0) = "" (* never call create_s with 0 *)
  118.       | substring("",_,_) = raise Substring
  119.       | substring(s,i,0) = if i>=0 
  120.                 then if boxed s then if i <= slength s
  121.                              then "" else raise Substring
  122.                          else if i<=1 
  123.                              then "" else raise Substring
  124.                 else raise Substring
  125.       | substring(s,0,1) = if boxed s then cast(ordof(s,0)) else s
  126.       | substring(s,i,1) =
  127.          if boxed s then if i>=0 andalso i < slength s 
  128.                     then cast(ordof(s,i))
  129.                     else raise Substring
  130.             else if i=0 then s else raise Substring
  131.       | substring(s,i,len) = 
  132.       if boxed s andalso i>=0 andalso i+len <= slength s
  133.         andalso len >= 0
  134.       then let val a = Assembly.A.create_s(len)
  135.            fun copy j = if j=len then ()
  136.                 else (store(a,j,ordof(s,i+j)); copy(j+1))
  137.            in  copy 0; a
  138.            end
  139.       else raise Substring
  140.  
  141.     fun explode s =
  142.       if boxed s
  143.         then let fun f(l,~1) = l
  144.                | f(l, i) = f(cast(ordof(s,i)) :: l, i-1)
  145.           in f(nil, slength s - 1)
  146.          end
  147.         else [s]
  148.     fun op ^ ("",s) = s
  149.       | op ^ (s,"") = s
  150.       | op ^ (x,y) =
  151.       if boxed x 
  152.       then if boxed y
  153.            then let val xl = slength x and yl = slength y
  154.             val a = Assembly.A.create_s(xl+yl)
  155.             fun copyx n = if n=xl then ()
  156.                   else (store(a,n,ordof(x,n)); copyx(n+1))
  157.             fun copyy n = if n=yl then ()
  158.                   else (store(a,xl+n,ordof(y,n)); copyy(n+1))
  159.              in copyx 0; copyy 0; a
  160.             end
  161.           else let val xl = slength x
  162.                val a = Assembly.A.create_s(xl+1)
  163.             fun copyx n = if n=xl then ()
  164.                   else (store(a,n,ordof(x,n)); copyx(n+1))
  165.             in copyx 0; store(a,xl,cast y); a
  166.            end
  167.       else if boxed y               
  168.            then let val yl = slength y
  169.             val a = Assembly.A.create_s(1+yl)
  170.             fun copyy n = if n=yl then ()
  171.                   else (store(a,1+n,ordof(y,n)); copyy(n+1))
  172.              in store(a,0,cast x); copyy 0; a
  173.             end
  174.           else let val a = Assembly.A.create_s 2
  175.             in store(a,0,cast x); store(a,1,cast y); a
  176.            end
  177.     fun chr i = if i<0 orelse i>255 then raise Chr else cast i
  178.     fun ord "" = raise Ord
  179.       | ord s = if boxed s then ordof(s,0) else cast s
  180.     val ordof = fn (s,i) =>
  181.       if boxed s
  182.             then if i<0 orelse i>= slength s then raise Ord else ordof(s,i)
  183.         else if i=0 then cast s else raise Ord
  184.     fun implode (sl:string list) =
  185.       let val len = List.fold(fn(s,l) => length s + l) sl 0
  186.       in  case len
  187.            of 0 => ""
  188.         | 1 => let fun find (""::tl) = find tl
  189.                  | find (hd::_) = cast hd
  190.                  | find nil = "" (* impossible *)
  191.                in  find sl
  192.                end
  193.         | _ => let val new = Assembly.A.create_s len
  194.                fun copy (nil,_) = ()
  195.                  | copy (s::tl,base) =
  196.                 let val len = length s
  197.                     fun copy0 0 = ()
  198.                       | copy0 i =
  199.                     let val next = i-1
  200.                     in  store(new,base+next,ordof(s,next));
  201.                         copy0 next
  202.                     end
  203.                 in  copy0 len;
  204.                     copy(tl,base+len)
  205.                 end
  206.             in  copy(sl,0);
  207.                 new
  208.             end
  209.       end
  210.     end (* local *)
  211.   end  (* structure String *)
  212.  
  213. structure General =
  214.   struct
  215.     open General
  216.     fun f o g = fn x => f(g x)
  217.     fun a before b = a
  218.   end (* structure General *)
  219.  
  220. structure Array =
  221.   struct
  222.    open Array
  223.    local open System.Unsafe in
  224.     val op sub : 'a array * int -> 'a =
  225.       fn (a,i) =>
  226.          if i<0 orelse i >= length a then raise Subscript
  227.          else subscript(a,i)
  228.     val update : 'a array * int * 'a -> unit =
  229.       fn (a,i,v) => 
  230.          if i<0 orelse i >= length a then raise Subscript
  231.          else update(a,i,v)
  232.    end (* local open ... *)
  233.   end (* structure Array *)
  234.  
  235. structure Integer =
  236.   struct
  237.     open Integer
  238.     fun op rem(a:int,b:int):int = a-((a quot b) * b)
  239.     fun min(a,b) = if a<b then a else b
  240.     fun max(a,b) = if a>b then a else b
  241.     fun abs a = if a<0 then ~a else a
  242.   end
  243.  
  244.  val inc = Ref.inc
  245.  val dec = Ref.dec
  246.  val hd = List.hd and tl = List.tl
  247.  val null = List.null and length = List.length
  248.  val op @ = List.@ and rev = List.rev
  249.  val map = List.map and fold = List.fold and revfold=List.revfold
  250.  val app = List.app and revapp = List.revapp
  251.  val nthtail = List.nthtail and nth = List.nth and exists = List.exists
  252.  val substring = String.substring and explode = String.explode
  253.  val op ^ = String.^ and chr = String.chr and ord = String.ord
  254.  val implode=String.implode
  255.  val op o = General.o and op before = General.before
  256.  val op sub = Array.sub and update= Array.update
  257.  val min = Integer.min and max = Integer.max 
  258.  
  259. end
  260.